home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr36
/
mapl0301.zip
/
ANSICHAT.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-04-13
|
18KB
|
363 lines
' $title: 'ANSIChat Split Screen Chat for RBBS-PC v17.4'
' By Dan Drinnon 8:903/2 1:313/6
' The Cellar Door RBBS (505) 763-1795 9600 v32
' Scott McNay 1:395/11
' The Wizard's II RBBS (817) 554-5331 9600 v32
'
' Copyright (c) 1992,1993 by Daniel T. Drinnon All Rights Reserved
'
' DO NOT Distribute in Modified Form!
'
' SEE ANSICHAT.DOC for LIMITATIONS OF USE
'
'REVISIONS:
'1.00 - 06-28-92 Initial Release
'1.01 - 06-29-92 Fix for F2 Shell to DOS from ANSICHAT
'1.02 - 07-04-92 Prevent F10 from Loading another ANSIChat
' Keep ANSIChat from showing 'RBBS' if that is already
' part of the BBS name.
' added support for Sysop's PgUp/PgDn (RBBSSUB3.BAS)
' combined local and remote input routines
'1.03 - 07-09-92 Greater control over ANSI colors independent of RBBS colors
'1.04 - 07-13-92 Added control to keep ANSICHAT from popping up when
' the sysop does not have ANSI installed according to
' CONFIG.
'1.05 - 07-19-92 Modified RBBSSUB3 to get status of ANSIChat Capability
' in DRSTx.DEF after return from a DOOR.
' Removed redundant code in RBBS-PC.BAS.
' Included ANSIFUN - a mod to make a Ring instead of a BEEP
' for Sysop Page.
'1.06 - 07-04-92 Gave the remote the option to terminate the chat by
' pressing ESC.
'1.07 - 08-10-92 Fixed BackSpace routine to properly locate the cursor.
'1.08 - 08-13-92 Fixed the wordwrap/color mix problem and tweaked the
' ANSI commands and a couple other things to speed up
' the I/O.
'1.09 - 08-18-92 Changed the bottom line of the remote screen to not go
' past line 23.
' Changed ZIP distribution file name to ACHATxxx.ZIP where xxx
' denotes the version number.
'1.10 - 08-26-92 Removed "STATIC" from SUB headers to force string space to
' be released after use.
' Added GetUserScreenSize sub to determine user's screen size
' so that screen layout can be determined dynamically. Makes
' ANSIChat more compatible with non-standard (25x80) screens.
' Changed exit method to require ESC key to be pressed twice.
' This is compatible with ANSIED, and prevents accidents when
' user hits a cursor key.
'
'1.11 - 09-09-92 Put the STATIC back in for QB3.0 compilers! Took out the
' GetUserScreenSize routines until a bug with certain modems
' which returns 1,1 as the size is squashed.
'
'1.12 - 02-09-93 Fixed colors for the "Chat Over..." String.
' Added a Current Time Clock in the Upper Right and an
' Elapsed Time Clock in the Upper Left screen
' Added support for CTRL-F to cycle through the ForeGround
' text colors. This is independent on the local and remote.
' Background color cycling was tested out, but although it
' worked, it just made for a sloppy looking screen and did
' not seem worth the extra code space.
'
' $INCLUDE: 'RBBS-VAR.MOD'
'
' $SUBTITLE: 'ANSIChat - ANSI Split Screen Chat Routine'
'
' $PAGE
'
' SUBROUTINE NAME -- ANSIChat
'
' INPUT PARAMETERS -- None
'
' OUTPUT PARAMETERS -- None
'
' SUBROUTINE PURPOSE -- Allows Split Screen ANSI Chat for RBBS
'
'
DIM ANSIRow(1), ANSICol(1), ACColor$(1), HoldInput$(1), StartRow(1)
DIM MaxRow(1), WasX$(1), LastChar$(1), ForeGround(8), ForeRotate(1) ' 1.12RT
DIM ForeHiLite(1) ' 1.12
'
Common Shared ANSIRow(), ANSICol(), ACColor$(), HoldInput$(), StartRow()
Common Shared MaxRow(), WasX$(), LastChar$() ' 1.10
Common Shared LocalOut, RemoteOut, SideOut
Common Shared MenuColor1$, MenuColor2$
Common Shared StartTime!, ElapsedTime!, ForeGround(), ForeRotate() ' 1.12
Common Shared ForeHiLite() ' 1.12
'
1000 SUB ANSIChat STATIC
'
StartTime! = TIMER ' 1.12
FOR count = 0 TO 7 ' 1.12
ForeGround(count) = count + 30 ' 1.12
NEXT ' 1.12
LocalOut = 0
RemoteOut = 1
SideOut = LocalOut
TimeChatStarted! = TIMER ' 1.10
ANSIRow(LocalOut) = 2
ANSIRow(RemoteOut) = 14
ANSICol(LocalOut) = 1
ANSICol(RemoteOut) = 1
ACColor$(LocalOut) = "32;40m" ' 1.08
ACColor$(RemoteOut) = "33;40m" ' 1.08
ForeRotate(LocalOut) = 2 ' 1.12
ForeHiLite(LocalOut) = 1 ' 1.12
ForeRotate(RemoteOut) = 3 ' 1.12
ForeHiLite(RemoteOut) = 1 ' 1.12
ZWasCM = ZTrue
ZSubParm = 1
HoldColorReset$ = ZColorReset$
MenuColor1$ = "33;44m" ' 1.08
MenuColor2$ = "36;44m" ' 1.08
ZColorReset$ = MenuColor2$ ' 1.03
CALL ANSIMenu
CALL ANSILocate (ANSIRow(LocalOut),ANSICol(LocalOut))
CALL QuickTPut1 (ACColor$(LocalOut) + ZSysopGreeting$)
CALL SplitScreenChat
ZWasCM = 0
CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
ZSecsPerSession! = ZSecsPerSession! + Elapsed!
IF NOT ZLocalUser THEN _
ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL ClearANSIScreen
ZColorReset$ = HoldColorReset$
CALL QuickTPut1(ZEmphasizeOff$ + ZCrLF$ + _ ' 1.12
"Chat over. BBS resuming" + ZColorReset$) ' 1.12
END SUB
'
4000 SUB ANSIMenu STATIC
'
LineBar$ = STRING$(80,177) ' 1.08
CALL ClearANSIScreen
CALL ANSILocate (1,1)
CALL QuickTPut (MenuColor2$ + LineBar$,0) ' 1.03
IF INSTR(ZRBBSName$,"BBS") <> 0 THEN _ ' 1.02
ZOutTxt$ = "░*>>> " + ZRBBSName$ + " ANSI Chat <<<*░" _ ' 1.02
ELSE _ ' 1.02
ZOutTxt$ = "░*>>> " + ZRBBSName$ + " RBBS ANSI Chat <<<*░" ' 1.02
temppos = (40 - (LEN(ZOutTxt$)/2))
CALL ANSILocate (1,temppos)
CALL QuickTPut (MenuColor1$ + ZOutTxt$,0) ' 1.03
CALL ANSILocate (13,1)
CALL QuickTPut (MenuColor2$ + LineBar$,0) ' 1.03
CALL ANSILocate (13,3)
CALL QuickTPut (MenuColor2$ + "░" + ZSysopFirstName$ + _ ' 1.03
" " + ZSysopLastName$ + "░",0) ' 1.03
CALL ANSILocate (13,43)
CALL QuickTPut (MenuColor2$ + "░" + ZActiveUserName$ + "░",0) ' 1.03
CALL Line25
END SUB
'
5000 SUB ClearANSIScreen STATIC
'
CALL QuickTPut ("",0) ' 1.03
ZSubParm = 2
CALL Line25
ZSubParm = 0
CALL ANSILocate (1,1)
END SUB
'
6000 SUB ANSILocate (ANSIRow,ANSICol) STATIC
'
CALL QuickTPut ("" + MID$(STR$(ANSIRow),2) + ";" + _
MID$(STR$(ANSICol),2) + "H",0)
END SUB
'
8000 SUB SplitScreenChat STATIC
'
8001 HoldInput$(LocalOut) = "" ' 1.01
HoldInput$(RemoteOut) = ""
MaxLen = 78
StartRow(LocalOut) = 2
StartRow(RemoteOut) = 14
MaxRow(LocalOut) = 12
MaxRow(RemoteOut) = 23 ' 1.09
ANSICol(LocalOut) = 1
ANSICol(RemoteOut) = 1
ANSIRow(LocalOut) = StartRow(LocalOut) + 1
ANSIRow(RemoteOut) = StartRow(RemoteOut)
WasX$(LocalOut) = ""
WasX$(RemoteOut) = ""
ZWaitExpired = ZFalse
'
8010 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL Carrier
IF ZSubParm < 0 THEN _
CALL QuickTPut1 (ZEmphasizeOff$) : _ ' 1.12
EXIT SUB
'
8020 CALL FindFKey
TimeNow! = TIMER ' 1.12
IF ZWasCM = 0 THEN _ ' 1.01
CALL FlushCom (ZCommPortStack$) : _ ' 1.01
ZKeyPressed$ = "" : _ ' 1.01
CALL ANSIMenu : _ ' 1.01
ZWasCM = ZTrue : _ ' 1.01
GOTO 8001 ' 1.01
IF TimeNow! - PrevTI! > 1.0 THEN ' 1.12
ElapsedTime! = TIMER ' 1.12
CALL CheckTime (StartTime!,ElapsedTime!,2) ' 1.12
ChatHour = ElapsedTime! / 3600 ' 1.12
ChatMin = (ElapsedTime! - ChatHour * 3600!) / 60 ' 1.12
ChatSec = ElapsedTime! - (ChatHour * 3600! + ChatMin * 60!) ' 1.12
IF ChatSec < 0 THEN ' 1.12
ChatSec = ChatSec + 60 ' 1.12
ChatMin = ChatMin - 1 ' 1.12
END IF ' 1.12
IF ChatMin < 0 THEN ' 1.12
ChatMin = ChatMin + 60 ' 1.12
ChatHour = ChatHour - 1 ' 1.12
END IF ' 1.12
Hours$ = STR$(ChatHour) ' 1.12
Mins$ = STR$(ChatMin) ' 1.12
Secs$ = STR$(ChatSec) ' 1.12
CALL Trim (Hours$) ' 1.12
CALL Trim (Mins$) ' 1.12
CALL Trim (Secs$) ' 1.12
IF ChatHour < 10 THEN Hours$ = "0" + Hours$ ' 1.12
IF ChatMin < 10 THEN Mins$ = "0" + Mins$ ' 1.12
IF ChatSec < 10 THEN Secs$ = "0" + Secs$ ' 1.12
CALL ANSILocate (1,1) ' 1.12
CALL QuickTPut (MenuColor1$ + Hours$ + ":" + _ ' 1.12
Mins$ + ":" + Secs$,0) ' 1.12
DisplayTime$ = LEFT$(TIME$,8) ' 1.12
CALL ANSILocate (1,73) ' 1.12
CALL QuickTPut (MenuColor1$ + DisplayTime$ + _ ' 1.12
ZEmphasizeOff$,0) ' 1.12
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut)) ' 1.12
PrevTI! = TimeNow! ' 1.12
END IF ' 1.12
SideOut = LocalOut
WasX$(LocalOut) = ZKeyPressed$
IF ZKeyPressed$ = ZEscape$ THEN _
CALL QuickTPut1 (ZColorReset$ + ZEmphasizeOff$) : _ 'Pe022493
EXIT SUB
IF WasX$(LocalOut) <> "" THEN _
GOTO 8060
'
8030 IF ZLocalUser THEN _
GOTO 8010
SideOut = RemoteOut
IF ZCommPortStack$ <> "" THEN _
WasX$(RemoteOut) = LEFT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
GOTO 9000
CALL EofComm (Char)
IF Char <> -1 THEN _
GOTO 8050 _
ELSE _
GOTO 8010
'
8050 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
CALL GetCom (WasX$(RemoteOut))
'
8060 'Control keys
LastChar$(SideOut) = RIGHT$(LastChar$(SideOut),1) + _ ' 1.10
WasX$(SideOut) ' 1.10
IF WasX$(SideOut) = CHR$(8) THEN _
GOTO 8500 _
ELSE IF WasX$(SideOut) = CHR$(9) THEN _
GOTO 8510 _
ELSE IF WasX$(SideOut) = CHR$(13) THEN _
GOTO 8520
IF WasX$(SideOut) = CHR$(6) THEN 'CTRL-F foreground ' 1.12
ForeRotate(SideOut) = ForeRotate(SideOut) + 1 ' 1.12
IF ForeRotate(SideOut) > 7 AND ForeHiLite(SideOut) = 1 THEN ' 1.12
ForeHiLite(SideOut) = 0 ' 1.12
ForeRotate(SideOut) = 0 ' 1.12
END IF ' 1.12
IF ForeRotate(SideOut) > 7 THEN ' 1.12
ForeHiLite(SideOut) = 1 ' 1.12
ForeRotate(SideOut) = 0 ' 1.12
END IF ' 1.12
hilite$ = STR$(ForeHiLite(SideOut)) ' 1.12
CALL Trim (hilite$) ' 1.12
colorstr$ = STR$(ForeGround(ForeRotate(SideOut))) ' 1.12
CALL Trim (colorstr$) ' 1.12
ACColor$(SideOut) = ZEscape$ + "[" + _ ' 1.12
hilite$ + ";" + _ ' 1.12
colorstr$ + "m" ' 1.12
GOTO 8010 ' 1.12
END IF ' 1.12
GOTO 9000
'
8500 'BackSpace
IF HoldInput$(SideOut) <> "" THEN _ ' 1.07
HoldInput$(SideOut) = LEFT$(HoldInput$(SideOut), _ ' 1.07
LEN(HoldInput$(SideOut))-1) ' 1.07
IF ANSICol(SideOut) > 1 THEN _
ANSICol(SideOut) = ANSICol(SideOut) - 1 : _ ' 1.07
GOTO 8501 ' 1.07
IF ANSICol(SideOut) = 1 THEN _ ' 1.07
GOSUB 8502 : _ ' 1.07
ANSICol(SideOut) = MaxLen - 1 : _ ' 1.07
ANSIRow(SideOut) = ANSIRow(SideOut) - 1 ' 1.03
IF ANSIRow(SideOut) < StartRow(SideOut) THEN _ ' 1.07
ANSIRow(SideOut) = MaxRow(SideOut) ' 1.07
8501 GOSUB 8502 ' 1.07
GOTO 8010
8502 CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut)) ' 1.07
tempstr$ = ACColor$(SideOut) + " " ' 1.12
IF NOT ZLocalUser THEN _ ' 1.07
CALL PutCom (tempstr$) ' 1.12
CALL LPrnt (tempstr$,0) ' 1.12
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut)) ' 1.07
RETURN ' 1.07
'
8510 'TAB
HoldInput$(SideOut) = ""
IF ANSICol(SideOut) + 5 > MaxLen THEN _
CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) _
ELSE _
ANSICol(SideOut) = ANSICol(SideOut) + 5 : _
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
GOTO 8010
'
8520 'CR
HoldInput$(SideOut) = ""
CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
GOTO 8010
'
9000 'Character Placement
IF LastChar$(SideOut) = ZEscape$ + ZEscape$ THEN _ ' 1.10
CALL QuickTPut1 (ZColorReset$ + ZEmphasizeOff$) : _ ' Pe022493
EXIT SUB
HoldInput$(SideOut) = HoldInput$(SideOut) + WasX$(SideOut)
IF WasX$(SideOut) = " " THEN _
HoldInput$(SideOut) = ""
IF ANSICol(SideOut) = MaxLen AND WasX$(SideOut) <> " " THEN _
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut) - _
LEN(HoldInput$(SideOut))) : _
CALL QuickTput(ACColor$(SideOut) + "", 0) : _ ' 1.08
CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) : _
CALL QuickTPut (HoldInput$(SideOut),0) : _
ANSICol(SideOut) = ANSICol(SideOut) + LEN(HoldInput$(SideOut)) - 1 : _
WasX$(SideOut) = "" : _
HoldInput$(SideOut) = ""
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
IF NOT ZLocalUser THEN _
CALL PutCom (ACColor$(SideOut) + WasX$(SideOut))
CALL LPrnt (ACColor$(SideOut) + WasX$(SideOut),0)
ANSICol(SideOut) = ANSICol(SideOut) + 1
IF ANSICol(SideOut) > MaxLen THEN _
CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
WasX$(SideOut) = ""
GOTO 8010
END SUB
'
10000 SUB AddRow (StartRow,MaxRow) STATIC
'
ANSICol(SideOut) = 1
ANSIRow(SideOut) = ANSIRow(SideOut) + 1
IF ANSIRow(SideOut) > MaxRow THEN _
ANSIRow(SideOut) = StartRow
IF ANSIRow(SideOut) < MaxRow THEN _
CALL ANSILocate (ANSIRow(SideOut) + 1,ANSICol(SideOut)) : _
CALL QuickTput(ACColor$(SideOut) + "", 0) ' 1.12
IF ANSIRow(SideOut) = MaxRow THEN _
CALL ANSILocate (StartRow,ANSICol(SideOut)) : _
CALL QuickTput(ACColor$(SideOut) + "", 0) ' 1.12
CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
END SUB
'